home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / nbase / nbase.for
Text File  |  1989-07-24  |  2KB  |  80 lines
  1.     program nbase
  2. c
  3. c---_----1----_----2----_----3----_----4----_----5----_----6----_----7--+
  4. c
  5. c     Written by Terry E. Koontz
  6. c                Sandia National Laboratories, SNLA
  7. c                Division 7553, Electromagnetic Analysis Group
  8. c                Albuquerque, NM 87185
  9. c                (505) 846-6036
  10. c
  11. c     Original: Jan. 12, 1988
  12. c     Revised:  Jul. 20, 1989
  13. c
  14. c Description:
  15. c
  16. c     Convert a number between bases 2 thru 62
  17. c
  18. c---_----1----_----2----_----3----_----4----_----5----_----6----_----7--+
  19. c
  20.     character*32 a,b,userp1
  21.     integer*4 c,r1,r2,v,v2
  22.     double precision t
  23.     
  24. 10    write(*,1) 
  25. 1       format(' Convert the number (0 to quit) ',$)
  26.         read(*,2) a
  27. 2    format(a32)
  28.     v=ichar(a(1:1))
  29.     if (v.eq.48) goto 999
  30.     
  31. 20    write(5,21)
  32. 21      format(' From base ',$)
  33.     read(*,*) r1
  34.     if ((r1.lt.2).or.(r1.gt.62)) then
  35.       write(*,*) '2 to 62 only'
  36.       goto 20
  37.     else
  38.     endif
  39.     
  40. 30    write(5,31)
  41. 31      format(' To base ',$)
  42.     read(*,*) r2
  43.     if ((r2.lt.2).or.(r2.gt.62)) then
  44.       write(*,*) '2 to 62 only'
  45.       goto 30
  46.     else
  47.     endif
  48.     
  49.     t=0
  50.     do 100 c=1,len(a)
  51.       v=ichar(a(c:c))
  52.       if (v.eq.32) goto 40
  53.       if ((v.ge.48).and.(v.le. 57)) v2=v-48
  54.       if ((v.ge.65).and.(v.le. 90)) v2=v-55
  55.       if ((v.ge.97).and.(v.le.122)) v2=v-61
  56.       if (v2.ge.r1) then
  57.         write(*,*) 'Character ',v,' invalid for base ',r1
  58.         goto 10
  59.       else
  60.       endif
  61.       t=t*r1+v2
  62. 100    continue
  63.     
  64. 40      b='                    '
  65.     c=20
  66. 200    if (t.eq.0) goto 300
  67.       v2=t-aint(t/r2)*r2
  68.       t=(t-v2)/r2
  69.       if (v2.le.9) v=v2+48
  70.       if ((v2.ge.10).and.(v2.le.35)) v=v2+55
  71.       if (v2.ge.36) v=v2+61
  72.       b(c:c)=char(v)
  73.       c=c-1        
  74.         goto 200
  75.     
  76. 300    write(*,*) 'The answer is: ',b(c:20)
  77.     goto 10
  78.     
  79. 999    end    
  80.